home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / sys / unix_timer.t < prev    next >
Text File  |  1988-02-05  |  3KB  |  70 lines
  1. (herald unix_timer (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26.  
  27. (define %%itimer_real    0)
  28. (define %%itimer_virtual 1)
  29. (define %%itimer_prof    2)
  30.  
  31. (define-foreign getitimer (getitimer (in rep/integer) (in rep/extend))
  32.   rep/integer)
  33.  
  34. (define-foreign setitimer (setitimer (in rep/integer)
  35.                                      (in rep/extend)
  36.                      (in rep/extend))
  37.   rep/integer)
  38.  
  39. (define %time (make-bytev 16))
  40. (define %otime (make-bytev 16))
  41. (define %stop (make-bytev 16))
  42.  
  43. (define-syntax (time expr . n)
  44.   (let ((n (if n (car n) 1)))
  45.      `((*value t-implementation-env '%monitor) ,n (lambda () ,expr))))
  46.  
  47.  
  48. ;** (%METER FN ITERATIONS TIME-OUT)
  49. ;** ===============================================================
  50. ;** Time INTERATIONS calls to FN.  The procedure should terminate
  51. ;** within TIME-OUT seconds or an interrupt will occur.
  52.  
  53. (define (%monitor repetitions thunk)
  54.   (set (mref-integer %time 8) time-out)
  55.   (set (mref-integer %time 12) 0)
  56.   (setitimer %%itimer_virtual %time %otime)
  57.   (receive vals (do ((i 1 (fx+ i 1)))
  58.             ((fx>= i repetitions) (thunk))
  59.           (thunk))
  60.        (getitimer %%itimer_virtual %time)
  61.        (let* ((usec (fx+ (fx* 1000000 (fx- (fx- time-out 1)
  62.                            (mref-integer %time 8)))
  63.                  (fx- 1000000 (mref-integer %time 12)))))
  64.          (format t "~&virtual time = ~s seconds~%"
  65.              (fl/ (->float usec) 1000000.0))
  66.          (setitimer %%itimer_virtual %stop %otime)
  67.          (apply return vals))))
  68.  
  69.  
  70. (define time-out 1000000)